Pascal Super Library/Pascal Super Library (CW International)(1997).bin/DELPHI32/FORM_UTL/SCRLFM10/SCRLFORM.PAS

Pascal/Delphi Source File | 1996-10-29 | 9.9 KB | 275 lines

unit Scrlform;

{
  Scrolling Form Gallery Component
  John Baumbach                         Delphi 1.0
  email: [e-mail]               Copyright (c) 10-20-96
  http://www.vcnet.com/mantis              by John Baumbach

  This component is 100% free and you are free to use it any
  way you wish.  If you have a use for this component, all I
  ask is that you e-mail me at the above address and let me
  know.  Thanks!


  Instructions for using the Scrolling Background template:

  Saving in the Form Gallery:

  To save this form in the gallery that pops up when you add a new form
  to your project, follow the instructions under Delphi help:  search for

           templates ->  Saving a Form as a Template.

  This basically tells you to open up this file, then display it's form.  Then,
  right click on the form to bring up the pop-up menu and select "Save as Template".
  For the title, type in "Scrolling Background" and for the description you
  can type in "New Form With a Scrolling Bitmap Background".  I have included
  an icon bitmap called "template.bmp" to use as the thumbnail image.

  Using the Scrolling Background form:

  This form gets the background image from a resource file, which I've included.
  When you select this form from the gallery, this resource file is not copied
  into your project directory.  You need to do this manually.  The resource
  file is called "IMAGES.RES".

  Note that this is a seperate file than the resource file "xx.RES" ("xx" is the
  name of your project), which is the project resource file used by Delphi.
  This file is overwritten during the compilation of the program, so you cannot
  store your bitmaps in it.

  The file is linked to your executable by the compiler resource directives:

     Existing line -->        {$R *.DFM}                                                    {
     Added line -->           {$R IMAGES.RES}                                               {

  This will link your resource file to the project during compilation.  The
  resource file has 9 bitmaps in it.  You can edit these bitmaps with the
  Delphi Image Editor or create your own resource file with other images.

  Changing the sign of "xmovement" and "ymovement" changes the scrolling
  direction of the bitmap.  The absolute value of these varibles is the number
  of pixels the bitmap moves per timer firing.  The form has not been debugged
  at values greater than one, so increase these at your own risk!

  Change the line:

    SetImage('BITMAP_1');

  in the OnCreate method to load other bitmaps.  There are 19 bitmaps in the resource file,
  ordered sequentially from BITMAP_1 to BITMAP_19.

  Other features:

  The form has an exception handling procedure built in to handle any errors
  during the form's run.  You can take this out without affecting the form.

  The background bitmap name and scrolling direction are declared as constants.
  You should make these variables if you wish to change the background during
  run time.

  If you just want a background without it scrolling, you can remove all the
  timer code.  Be sure to leave the resizing and painting code intact.

  Possible improvements:

  Some components don't look too good on the form itself, such as labels.  If you
  need to use a label on your form, I would recommend putting it on (in??) a
  panel component so you can see it before it's overwritten.

  My demo version of this form allows you to load a bitmap from a file during
  runtime for use as a background.  It also allows you to include a bitmap file
  name on the command line and it starts up with that bitmap as a background.

  Performance:

  The background scrolls smoothly with a full screen form on a 486-100mhz
  running Windows95 w/32 meg RAM using the default settings.  Decreasing the
  timer interval can speed up the scrolling, but may degrade performance when
  the form is full screen.

  Disclaimer:

  This component is provided free of charge, and you are free to do anything
  with the code presented here.  There is no warranty on this product and the
  author accepts no liability for any damage that may be caused to the user's
  system by this product.  In other words, use at your own risk.

  If you have any problems or have any comments you can reach me at:

       [e-mail]     -and-   http://www.vcnet.com/mantis

 }

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, ExtCtrls, Menus, StdCtrls;

type
  Tscrollform = class(TForm)
    backtimer: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure GetDIBBMP(Name: string);
    procedure FormPaint(Sender: TObject);
    procedure backtimerTimer(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    { Private declarations }
    procedure HandleException(Sender: TObject; E: Exception);
    procedure SetImage(Name: string);
  public
    { Public declarations }
  end;

const
  xmovement = 1;            { Scrolls horizontally x pixels per movement}
  ymovement = -1;           { Scrolls vertically x pixels per movement}
  TimerInterval = 100;      { Scroll interval in milliseconds }

var
  scrollform: Tscrollform;
  BackImage, FormBitmap: TBitmap;
  xoffset, yoffset: integer;
  DoingResize, NeedToQuit, AmQuitting: boolean;
  BitmapName: string;             { Name of bitmap in resource file }

implementation

{$R *.DFM}
{$R images.res}

procedure Tscrollform.SetImage(Name: string);
begin
    BitmapName:=Name;
    GetDIBBMP(Name);       {Load the bitmap from RES file into 'Backimage'}
    FormResize(Self);      {Create the form background image}
end;

procedure Tscrollform.FormCreate(Sender: TObject);
begin
    Application.OnException:=HandleException; {Procedure to handle any exceptions}
    BackImage:= TBitmap.Create;               {Create background image from resource file}
    FormBitmap:= TBitmap.Create;              {Create bitmap to copy to form on repaint calls}
    xoffset:=0; yoffset:=0;                   {Init "FormBitmap" coordinates}
    SetImage('BITMAP_1');                     {Set "Backimage" }
end;

procedure Tscrollform.HandleException(Sender: TObject; E: Exception);
begin
    backtimer.enabled:=false;
    MessageDlg('Oops... An exception: ' + E.Message, mtError,
      [mbOk], 0);
end;

procedure Tscrollform.FormDestroy(Sender: TObject);
begin
    backtimer.enabled:=false;
    BackImage.Free;
    FormBitmap.Free;
end;

procedure Tscrollform.GetDIBBMP(Name: string);
{ Code to load DIB from a resource file without palette shift (hopefully).  This
  was obtained from the Borland Delphi Technical Support page at:

      http://www.borland.com   }

const
  BM = $4D42;  {Bitmap type identifier}
var
  BMF: TBitmapFileHeader;
  HResInfo: THandle;
  MemHandle: THandle;
  Stream: TMemoryStream;
  ResPtr: PByte;
  ResSize: Longint;
  TempName: PChar;
begin
  BMF.bfType := BM;
  {Find, Load, and Lock the Resource containing BITMAP_1}
  TempName:=StrAlloc(Length(Name));
  StrPCopy(TempName, Name);
  HResInfo := FindResource(HInstance, TempName, RT_Bitmap);
  StrDispose(TempName);
  MemHandle := LoadResource(HInstance, HResInfo);
  ResPtr := LockResource(MemHandle);

  {Create a Memory stream, set its size, write out the bitmap
   header, and finally write out the Bitmap                  }
  Stream := TMemoryStream.Create;
  ResSize := SizeofResource(HInstance, HResInfo);
  Stream.SetSize(ResSize + SizeOf(BMF));
  Stream.Write(BMF, SizeOf(BMF));
  Stream.Write(ResPtr^, ResSize);

  {Free the resource and reset the stream to offset 0}
  FreeResource(MemHandle);
  Stream.Seek(0, 0);

  {Create the TBitmap and load the image from the MemoryStream}
  Backimage.LoadFromStream(Stream);
  Stream.Free;
end;

procedure Tscrollform.FormPaint(Sender: TObject);
begin
    Canvas.Draw(0 - xoffset, 0 - yoffset, FormBitmap);
end;

procedure Tscrollform.backtimerTimer(Sender: TObject);
begin
    { This procedure runs each time the timer inverval arrives.               }
    { It is used to calculate the position of the main bitmap for painting    }
    { on the form.                                                            }

    xoffset:=xoffset + xmovement;
    if xmovement > 0 then begin           { if scrolling right to left }
        if xoffset >= BackImage.Width then xoffset:=0;
    end
    else if xmovement < 0 then            { if scrolling left to right }
        if xoffset <= 0 then xoffset:=BackImage.Width;

    yoffset:=yoffset + ymovement;
    if ymovement > 0 then begin           { if scrolling bottom to top }
        if yoffset >= BackImage.Height then yoffset:=0;
    end
    else if ymovement < 0 then            { if scrolling top to bottom }
        if yoffset <= 0 then yoffset:=BackImage.Height;

    Paint;                                {Repaint the screen}
end;

procedure Tscrollform.FormResize(Sender: TObject);
var x, y: integer;
begin
    {Don't want two resizers running at same time}
    if DoingResize then exit;
    DoingResize:=true;

    {Set size of "FormBitmap" to size of form, and add size of image
     so the image will be slightly larger than the form canvas.  That
     way "FormBitmap" won't leave any white edges around the form
     when it's scrolled.}

    try
       FormBitmap.Width:=Width + BackImage.Width;
       FormBitmap.Height:=Height + BackImage.Height;
    except
       {Bitmaps have been freed, program was trying to exit then timer expired!!!}
       exit;
    end;

    {Copy "Backimage" to fill up "FormBitmap" }
    for x:=0 to ((Width div BackImage.Width) + 1) do
       for y:=0 to ((Height div BackImage.Height) + 1) do
          FormBitmap.Canvas.Draw(x * BackImage.Width,
                 y * BackImage.Height, BackImage);
    DoingResize:=false;
end;

end.